home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBOBJS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-04  |  16KB  |  371 lines
  1. {SECTION ..PbOBJS }
  2. UNIT PbOBJS;
  3.  
  4. INTERFACE
  5.  
  6. uses DOS, printer, PbMISC, PbDATA;
  7.  
  8. {
  9. Description : HNR Object Library
  10.  
  11. Author      : Howard Richoux
  12. Date        : 2/18/91
  13. Last revised: 2/18/94 TFILE_object, BFILE_object, STRA_object
  14.               2/18/94 INFO_object, LOOKUP_object
  15.               2/18/94 OUT_object_0, OUT_object_1
  16. Application : IBM PC and compatibles, done in Turbo Pascal 7
  17. Status      : Placed in the Public Domain by HNR Software 2/18/1994
  18. Published in: none
  19. }
  20.  
  21.  
  22. {SECTION .BFILE_object }
  23.  
  24. const BFILE_maxheader       = 1024;
  25. type  BFILE_headerbuf_type  = array[1..BFILE_maxheader] of byte;
  26. const BFILE_Bad_Recnum_ERR  = -5;
  27. type  BFILE_RecToStringProc = procedure(var rec; var s : string);
  28. type  BFILE_StringToRecProc = procedure(s : string; var rec);
  29.  
  30. TYPE  BFILE_object = OBJECT
  31.              Fil      : file;
  32.              filename : string[60];
  33.              recsiz   : integer;
  34.              opened   : boolean;
  35.              position : longint;
  36.              err      : integer;
  37.              curr     : longint;
  38.              hdrptr   : ^BFILE_headerbuf_type;
  39.              hdrsiz   : integer;
  40.  
  41.              procedure init(fn : string; recsz,FMode : integer);
  42.              procedure InitWithHdr(fn : string; recsz,hdsz,FMode : integer);
  43.              Procedure open       (fn : string; create : boolean);
  44.              Procedure SetHdrSiz  (hdsz : integer); { Mostly for reading, like DBF }
  45.              Function  UpDateHeader   : boolean;    { Rewrites hdr buffer }
  46.              Function  ReadHeader     : boolean;    { Reads file for hdr buffer }
  47.              Function  IOResultErrChk : boolean;    { Checks IOResult, sets Err }
  48.              Function  NoError        : boolean;    { Checks Err variable }
  49.              Function  Count          : longint;    { Computes based on filesize }
  50.              Procedure close;
  51.              Procedure clearfile;
  52.              Procedure refreshfile;
  53.  
  54.              Function  RecAddress(n : longint) : longint;  { Computes based on hdrsiz and recsiz }
  55.              function  SeekN     (n : longint)          : boolean;  { First rec is rec #1 }
  56.              function  fetchN    (n : longint; var rec) : boolean;  { Fetches recs 1.. count}
  57.              function  storeN    (n : longint; var rec) : boolean;  { stores any n>0}
  58.              function  fetchnext (var rec)              : boolean;  { inc(curr) and fetchN}
  59.              Function  append    (var rec)              : boolean;  { stores count+1 }
  60.  
  61.              Procedure export (fn : string; workproc : BFILE_RecToStringproc;
  62.                                var rec; purgedata : boolean);
  63.              Procedure import (fn : string; workproc : BFILE_StringToRecproc;
  64.                                var rec; purgedata : boolean);
  65.              Procedure Dump;       { debugging aid }
  66.              Procedure SmartDump;  { uses header & records -  debugging aid }
  67.              Procedure done;
  68.              end;
  69.  
  70.  
  71.  
  72.  
  73. {SECTION .TFILE_object }
  74.  
  75. TYPE  TFILE_object = OBJECT
  76.              Fil      : TEXT;
  77.              filename : string[60];
  78.              opened   : boolean;
  79.              err      : integer;
  80.              linenum  : longint;
  81.              PosCurr  : longint;
  82.  
  83.              procedure init      (fn : string; create : boolean);
  84.              procedure initAppend(fn : string);
  85.              Procedure open      (fn : string; create : boolean);
  86.              Function  IOResultErrChk : boolean;
  87.              Procedure seek      (l : longint);
  88.              function  currentposition : longint;
  89.              Function  fetchnext(var s : string) : boolean;
  90.              Function  append(s : string) : boolean;
  91.              Procedure clearfile;
  92.              Procedure refreshfile;
  93.              Function  error    : boolean;
  94.              Procedure close;
  95.              procedure done;
  96.              end;
  97.  
  98.  
  99.  
  100. {SECTION .STR_object }
  101. type  stringptr = ^string;
  102.  
  103. TYPE  STR_object = OBJECT
  104.              strptr: stringptr;                       { pointer to string on heap }
  105.              Procedure   init;                        { gets heap space     }
  106.              Function    store (st: String): boolean; { Stores the string   }
  107.              Function    fetch: String;               { Fetches the string  }
  108.              Procedure   dump;                        { debug write         }
  109.              procedure   dispose;                     { releases heap space }
  110.              end;
  111.  
  112.  
  113.  
  114. {SECTION .STRA_object }
  115. const STRA_BigArrayMax = 15000;
  116. type  STRA_BigArray = array[1..STRA_BigArrayMax] of STR_object;
  117. {type  STRA_BigIndex = array[1..STRA_BigArrayMax] of integer;}
  118.  
  119. TYPE  STRA_object = OBJECT
  120.              arrayptr    : ^STRA_BigArray;
  121.              arraymax    : integer;
  122.              arrayused   : integer;
  123.              arraysorted : boolean;
  124.              modified    : boolean;
  125.              Procedure init         (max : integer);
  126.              Function  append       (st : string)              : boolean;
  127.              Function  appendpush   (st : string)              : boolean;
  128.              Function  insertstr    (n : integer;st : string)  : boolean;
  129.              Function  deletestr    (n : integer)              : boolean;
  130.              Function  linearfind   (st : string)              : integer;
  131.              Function  linearsearch (st : string; mode : byte) : integer;
  132.              Function  storeN       (n : integer; st : string) : boolean;
  133.              Function  fetchN       (n : integer) : string;
  134.  
  135.              Function  fetchString  (n : integer) : string;  {returns nth string as itself}
  136.              Function  fetchInteger (n : integer) : integer; {returns nth string as integer}
  137.              Function  fetchLongInt (n : integer) : longint; {returns nth string as longint}
  138.              Function  fetchreal    (n : integer) : real;    {returns nth string as real}
  139.              Function  fetchboolean (n : integer) : boolean; {returns nth string as boolean}
  140.  
  141.              Function  count        : integer; { returns number of slots used }
  142.              Function  sorted       : boolean; { returns whether sorted }
  143.              Function  arraymaxsize : integer; { returns max (from init)}
  144.              Procedure dump;                   { for debugging }
  145.              Procedure clear;                  { empties array }
  146.  
  147.              Procedure listpage   (f,n,w : integer);           { mini dump for text windows }
  148.              Procedure save       (fname : string);            { to text file }
  149.              Procedure load       (fname : string);            { from text file }
  150.              Procedure loadsection(fname,sectiontag,sectionname : string); { from text file }
  151.  
  152.              Procedure swap(i,j : integer);                    { for sort }
  153.              Procedure sort;                                   { shell sort}
  154.              Function  binsearchEQ    (st : string) : integer; { if sorted }
  155.              Function  binsearchAPPROX(st : string) : integer; { if sorted }
  156.              Function  binsearchLE    (st : string) : integer; { if sorted }
  157.              Function  binsearchGE    (st : string) : integer; { if sorted }
  158.  
  159.              Function  find   (st : string) : integer;              { sorted or not }
  160.              Function  search (st : string; mode : byte) : integer; { sorted or not }
  161.              Procedure done;
  162.              end;
  163.  
  164.  
  165. {SECTION .INFO_object }
  166. type  INFO_object = object
  167.           infoheader         : STR_object;
  168.           keystring,keyvalue : STRA_object;
  169.           sepchar            : char;      { separator between key and value ';' }
  170.           sortmode,sorted    : boolean;
  171.           CONSTRUCTOR init(max : integer);
  172.           Function  count                     : integer;
  173.           Function  arraymaxsize              : integer;
  174.  
  175.           Function  storeheader (s : string) : boolean;
  176.           Function  fetchheader : string;
  177.           Function  store        (ks,kv : string) : boolean;
  178.           Function  fetch        (ks : string)    : string;
  179.           Function  FetchString  (ks : string) : string;
  180.           Function  FetchInteger (ks : string) : integer;
  181.           Function  Fetchreal    (ks : string) : real;
  182.           Function  FetchLongInt (ks : string) : longint;
  183.           Function  FetchBoolean (ks : string) : boolean;
  184.           Function  fetchkeyn    (n : integer)   : string;   { fetch nth key}
  185.           Function  fetchn       (n : integer)    : string;  { fetch nth item}
  186.           Function  search       (ks : string; mode : byte) : string;
  187.           Procedure load         (fname : string);
  188.           Procedure save         (fname : string);
  189.           Procedure swap         (i,j  : integer);
  190.           Procedure setsortmode  (flag : boolean);
  191.           Procedure setsepchar   (sep  : char);
  192.           Procedure sort;
  193.           Procedure dump;
  194.           Procedure clear;
  195.           Procedure done;
  196.           end;
  197.  
  198.  
  199. {SECTION .LOOKUP_object }
  200. type LOOKUP_object = object
  201.         hold : INFO_object;
  202.  
  203.         Procedure init(num : integer);
  204.         Procedure append(tag,str : string);
  205.         Function  lookup (tag : string) : string;
  206.         Function  fetchN(n : integer) : string;
  207.         Procedure done;
  208.         Procedure dump;
  209.         end;
  210.  
  211.  
  212. {SECTION .HOLD_object }
  213. const HOLD_BigIndexMax = 5000;   { find out real limits - hnr 1/94 }
  214.  
  215. type  HOLD_NumType     = longint;
  216. type  HOLD_NdxType     = integer;
  217. type  HOLD_BigIndex    = array[1..HOLD_BigIndexMax] of HOLD_NumType;
  218.  
  219.  
  220. TYPE  HOLD_object = OBJECT(STRA_object)
  221.         ArrNum     : ^HOLD_BigIndex;
  222.         ArrHighVal : HOLD_NumType;
  223.         MaxEntries : HOLD_NdxType;
  224.  
  225.         comment    : string[80];
  226.  
  227.         CONSTRUCTOR init   (n : HOLD_NdxType);
  228.         Function  append   (                st :string;     Num :HOLD_NumType): Boolean;
  229.         Function  storeN   (n : HOLD_NdxType;    st :string;     Num :HOLD_NumType): Boolean;
  230.         Function  fetchN   (n : HOLD_NdxType;var st :string; var Num :HOLD_NumType): Boolean;
  231.         Function  fetchNumN(n : HOLD_NdxType)   : HOLD_NumType;
  232.         Function  fetchStrN(n : HOLD_NdxType)   : string;
  233.  
  234.         Function  findstr  (st  : string)    : HOLD_NdxType;
  235.         Function  findnum  (Num : HOLD_NumType)   : HOLD_NdxType;
  236.  
  237.         Function  count                    : HOLD_NdxType;
  238.         Function  HighNum                  : HOLD_NumType;
  239.         Procedure swap     (i,j : HOLD_NdxType);
  240.         Procedure sort;
  241.         Procedure dump;
  242.         Procedure dumpN    (n : HOLD_NdxType);
  243.         Procedure save     (fname : string);
  244.         Procedure load     (fname : string);
  245.         Procedure done;
  246.         end;
  247.  
  248.  
  249.  
  250. {SECTION .OUT_objects }
  251.  
  252. const OUT_typCRT  = 1;
  253.       OUT_typPRT  = 2;
  254.       OUT_typFIL  = 3;
  255.       OUT_typNUL  = 4;
  256.  
  257.       OUT_typAPPEND  = 0;     { append to existing file }
  258.       OUT_typREWRITE = 1;     { rewrite file }
  259.  
  260. type OUT_object_0 = OBJECT        { basic functionality }
  261.        DevTyp    : byte;        { typCRT }
  262.        app       : byte;        { typAPPEND }
  263.        f         : TEXT;
  264.        fname     : string[40];  { '' - file name }
  265.        plen      : integer;     { 24 - lines per page }
  266.        llen      : integer;     { 79 - chars per line }
  267.        currllen  : integer;     { llen - changed with indenting and offset }
  268.        currline  : integer;     { 1  - current line number }
  269.        currpage  : integer;     { 1  - current page number }
  270.        loff      : byte;        { 0  - line offset for everything}
  271.        indent    : byte;        { 0  - line indent for data, beyond offset }
  272.        linesprinted : longint;  { 0  - only data lines, no headers ...}
  273.        linesmax  : longint;     { 999999 - print line limit }
  274.  
  275.        opened    : boolean;     { false - false if open failed }
  276.        err       : integer;     { 0     - holds error number }
  277.        nopause   : boolean;     { false - don't pause if CRT }
  278.        noprint   : boolean;     { false - suppress actual I/O while true }
  279.        loffstr   : string;      { ''    - pad at left of line }
  280.        indentstr : string;      { ''    - pad at left of line }
  281.  
  282.        compressed     : boolean;     { true   - laser Esc seq. }
  283.        landscape      : boolean;     { false  - laser Esc seq. }
  284.        PrinterInitted : boolean;
  285.  
  286.        Procedure init(fn: string; dtyp, append : byte;
  287.                       pl, lw : integer; off : byte);
  288.        Procedure LISTInit(fn: string; append : byte);  { simplified }
  289.        Procedure LISTOpen;              { Do the actual OPEN i/o }
  290.        Procedure ResetCounts;
  291.        Procedure SetOffSet( i : byte);  { left margin }
  292.        Procedure SetIndent( i : byte);  { left margin }
  293.        Procedure SetNoPause;            { don't pause at e.o.p if CRT }
  294.        Procedure SetCompressed;         { sets flag for InitPrinter }
  295.        Procedure SetLandscape;          { sets flag for InitPrinter }
  296.        Procedure pause;                 { wait for key if CRT }
  297.        Procedure formfeed;              { <ff> if printer, pause if CRT }
  298.        Procedure OutHeader;             { basicly dummy routine }
  299.        Procedure OutFooter;             { basicly dummy routine }
  300.        Procedure OutERRNoCR(s : string);{ no CR/LF, no bookkeeping }
  301.        Procedure OutERR(s : string);    { actual write }
  302.        Procedure Out(s : string);       { with bookkeeping }
  303.  
  304.        Procedure DoneWithPage;
  305.        Procedure done;
  306.  
  307.        Procedure InitPrinter;                            { *private* }
  308.        Procedure HandleFName(fn: string; append : byte); { *private* }
  309.        end;
  310.  
  311.  
  312.  
  313. type OUT_object_1 = OBJECT(OUT_object_0)    { fancy }
  314.        alldone      : boolean;     { false }
  315.        header1spec  : string[50];  { page header def '||@PAGE'}
  316.        header2spec  : string[30];  { second line def ''}
  317.        header3spec  : string[30];  { third       def ''}
  318.        footer2spec  : string[30];  { above the footer line  def '' }
  319.        footer1spec  : string[50];  { page footer def ''}
  320.        pagelabel1   : string[40];  { misc string @LABEL1 }
  321.        pagelabel2   : string[40];  { misc string @LABEL2 }
  322.        pagelabel3   : string[40];  { misc string @LABEL3 }
  323.  
  324.        joinflag     : boolean;     {number of lines to join   }
  325.        joinwidth    : integer;     {point to break lines      }
  326.        joinlinehold : string;      {holding area for leftovers}
  327.  
  328.  
  329.        Procedure LISTInit(fn: string; append : byte);  { simplified }
  330.        Procedure init(fn: string; dtyp, append : byte;
  331.                                   pl, lw : integer; off : byte);
  332.        Procedure SetHeaders(h1spec,h2spec,h3spec,f1spec,f2spec : string);
  333.  
  334.        Procedure Out(s : string);     { with bookkeeping }
  335.        Procedure OutHeader;           { fancy }
  336.        Procedure OutFooter;           { fancy }
  337.  
  338.        Procedure DoneWithPage;        { to get Footers }
  339.        Procedure done;                { to get Footers }
  340.  
  341.        Procedure FlushJoin(joindone : boolean);
  342.        Procedure OutJoin(line : string);
  343.  
  344.        {Private methods}
  345.        Function  SpecialStr(str : string) : string;
  346.        Function  FmtHeaderPiece(spec : string) : string;
  347.        Function  pFmtHeader(spec : string; width : integer) : string;
  348.        end;
  349.  
  350.  
  351.  
  352.  
  353. {SECTION .zIMPLEMENTATION }
  354. IMPLEMENTATION
  355.  
  356. {$I objBFILE.inc }
  357.  
  358. {$I objTFILE.inc }
  359.  
  360. {$I objSTRA.inc }
  361.  
  362. {$I objINFO.inc }
  363.  
  364. {$I objHOLD.inc }
  365.  
  366. {$I objOUT.inc }
  367.  
  368. {SECTION _Initialization }
  369.      begin {Initialization }
  370.      end.
  371.